Gold Medal Software 1/Gold Medal Software Volume 1 (Gold Medal) (1994).iso/prog/tpwprog7.arj/SERVER.PAS

Pascal/Delphi Source File | 1992-07-02 | 5.1 KB | 190 lines

{ server.pas -- Simple (cold link) DDE server }

program Server;

{$R server.res}

uses WinTypes, WinProcs, WObjects, Strings, StdDlgs;

const

  id_Menu      = 100;    { Menu resource ID }
  cm_EnterData = 101;    { Enter data command ID }
  cm_ClearData = 102;    { Clear data command ID }
  cm_Quit      = 103;    { Exit command ID }
  maxDataLen   = 64;     { Maximum length of data string }

  serverName = 'Server';  { Name of server application }
  serverTopic = 'Data';   { Name of data to be transferred }

type

  ServerApplication = object(TApplication)
    procedure InitMainWindow; virtual;
  end;

  PServerWindow = ^ServerWindow;
  ServerWindow = object(TWindow)
    Data: array[0 .. maxDataLen] of Char;
    constructor Init(AParent: PWindowsObject; ATitle: PChar);
    procedure Paint(PaintDC: HDC;
      var PaintInfo: TPaintStruct); virtual;
    procedure WMDDEInitiate(var Msg: TMessage);
      virtual wm_First + wm_DDE_Initiate;
    procedure WMDDETerminate(var Msg: TMessage);
      virtual wm_First + wm_DDE_Terminate;
    procedure WMDDERequest(var Msg: TMessage);
      virtual wm_First + wm_DDE_Request;
    procedure CMEnterData(var Msg: TMessage);
      virtual cm_First + cm_EnterData;
    procedure CMClearData(var Msg: TMessage);
      virtual cm_First + cm_ClearData;
    procedure CMQuit(var Msg: TMessage);
      virtual cm_First + cm_Quit;
  end;


{ ServerApplication }

{- Initialize ServerApplication object's window }
procedure ServerApplication.InitMainWindow;
begin
  MainWindow := New(PServerWindow, Init(nil, serverName))
end;


{ ServerWindow }

{- Construct ServerWindow object }
constructor ServerWindow.Init(AParent: PWindowsObject; ATitle: PChar);
begin
  TWindow.Init(AParent, ATitle);
  with Attr do
  begin
    Menu := LoadMenu(HInstance, PChar(id_Menu));
    X := 300; Y := 10; W := 275; H := 300
  end;
  Data[0] := #0
end;

{- Respond to wm_DDE_Initiate request from client }
procedure ServerWindow.WMDDEInitiate(var Msg: TMessage);
var
  appAtom, appTopic: TAtom;
begin
  appAtom := GlobalAddAtom(serverName);
  appTopic := GlobalAddAtom(serverTopic);
  if SendMessage(
    Msg.WParam,   { Client's window handle }
    wm_DDE_Ack,   { Acknowledge receipt of initiate request }
    HWindow,      { Server's window handle }
    MakeLong(appAtom, appTopic  { Global atoms }
  )) = 0 then
  begin
    GlobalDeleteAtom(appAtom);
    GlobalDeleteAtom(appTopic)
  end
end;

{- Respond to wm_DDE_Terminate message }
procedure ServerWindow.WMDDETerminate(var Msg: TMessage);
begin
  PostMessage(Msg.WParam, wm_DDE_Terminate, HWindow, 0)
end;

{- Respond to a client's request for data }
procedure ServerWindow.WMDDERequest(var Msg: TMessage);
var
  HData: THandle;     { Handle to data's memory block }
  PData: PDDEData;    { Pointer to data }
  AppTopic: TAtom;    { Global atom identifies topic }
  DataError: Boolean; { General purpose error flag }
begin

  AppTopic := HiWord(Msg.LParam);
  {- Inspect or copy AppTopic here if necessary }
  DataError := (StrLen(Data) = 0) or (LoWord(Msg.LParam) <> cf_Text);

  {- Prepare data for transmission }
  if not DataError then
  begin
    HData := GlobalAlloc(gmem_Moveable or gmem_DDEShare,
      Sizeof(TDDEData) + StrLen(Data) + 1);
    if HData <> 0 then
    begin
      PData := GlobalLock(HData);
      if PData = nil then
      begin
        GlobalFree(HData);
        DataError := true
      end else
      begin
        PData^.Flags := dde_Release;  { Client must release data }
        PData^.CfFormat := cf_Text;
        Move(Data, PData^.Value, StrLen(Data) + 1);
        GlobalUnlock(HData)
      end
    end
  end;

  {- Transmit error or data }
  if DataError then
    PostMessage(Msg.WParam, wm_DDE_Ack, HWindow,
      MakeLong(0, AppTopic))  { Post negative acknowledgement }
  else
    if not PostMessage(Msg.WParam, wm_DDE_Data, HWindow,
      MakeLong(HData, AppTopic)) then
    begin
      GlobalFree(HData);
      GlobalDeleteAtom(AppTopic)
    end

end;

{- Enter new server data, sent on request to a client }
procedure ServerWindow.CMEnterData(var Msg: TMessage);
begin
  Application^.ExecDialog(New(PInputDialog,
    Init(@Self, 'Input Server Data', 'Enter a line of text: ',
    Data, Sizeof(Data))));
  InvalidateRect(HWindow, nil, true)
end;

{- Erase current data }
procedure ServerWindow.CMClearData(var Msg: TMessage);
begin
  Data[0] := #0;
  InvalidateRect(HWindow, nil, true)
end;

{- Exit application }
procedure ServerWindow.CMQuit(var Msg: TMessage);
begin
  CloseWindow
end;

{- Display current data in window }
procedure ServerWindow.Paint(PaintDC: HDC;
  var PaintInfo: TPaintStruct);
begin
  TWindow.Paint(PaintDC, PaintInfo);
  if StrLen(Data) > 0 then
    TextOut(PaintDC, 10, 100, Data, StrLen(Data))
end;

var

  ServerApp: ServerApplication;

begin
  ServerApp.Init('ServerApp');
  ServerApp.Run;
  ServerApp.Done
end.


{--------------------------------------------------------------
  Copyright (c) 1991 by Tom Swan. All rights reserved.
  Revision 1.00    Date: 5/27/1991
---------------------------------------------------------------}